home *** CD-ROM | disk | FTP | other *** search
/ Network Supervisor's Toolkit / Network Supervisor's Toolkit.iso / btrieve / btp15 / btp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-07-10  |  40.1 KB  |  1,040 lines
  1. UNIT BTP;    {Version 1.5  11/9/91                      (C) 1991 John C. Leon}
  2.  
  3. {$A+}    {word alignment.  Btrieve interface call wants this global directive
  4.           set; is the default compiler setting anyway.                       }
  5.  
  6. INTERFACE
  7. (* ------------------------------------------------------------------------ *)
  8. (* ------------------------------------------------------------------------ *)
  9. USES Objects, Memory;
  10.  
  11. CONST
  12. {      Key Attributes            Key Types          Open Modes               }
  13. {    ------------------      ----------------     ---------------            }
  14.      Duplicates   =   1;     BString    =  0;     Normal    =  0;
  15.      Modifiable   =   2;     BInteger   =  1;     Accel     = -1;
  16.      Binary       =   4;     BFloat     =  2;     ReadOnly  = -2;
  17.      Null         =   8;     BDate      =  3;     Verify    = -3;
  18.      Segmented    =  16;     BTime      =  4;     Exclusive = -4;
  19.      AltCol       =  32;     BDecimal   =  5;
  20.      Descending   =  64;     BMoney     =  6;   {        File Flags        }
  21.      Supplemental = 128;     BLogical   =  7;   { ------------------------ }
  22.      ExtType      = 256;     BNumeric   =  8;     VarLength   =  1;
  23.      Manual       = 512;     BBFloat    =  9;     BlankTrunc  =  2;
  24.                              BLString   = 10;     PreAllocate =  4;
  25.                              BZString   = 11;     DataComp    =   8;
  26.                              BUnsBinary = 14;     KeyOnly     =  16;
  27.                              BAutoInc   = 15;     Free10      =  64;
  28.                                                   Free20      = 128;
  29.                                                   Free30      = 192;
  30.  
  31. {              Btrieve Op Codes                      Error Codes             }
  32. {  -----------------------------------------   ------------------------      }
  33.    BOpen      =  0;       BAbortTran   = 21;   FileNotOpen      =  3;
  34.    BClose     =  1;       BGetPos      = 22;   InvalidKeyNumber =  6;
  35.    BInsert    =  2;       BGetDir      = 23;   DiffKeyNumber    =  7;
  36.    BUpdate    =  3;       BStepNext    = 24;   InvalidPosition  =  8;
  37.    BDelete    =  4;       BStop        = 25;   EndofFile        =  9;
  38.    BGetEqual  =  5;       BVersion     = 26;   FileNotFound     = 12;
  39.    BGetNext   =  6;       BUnlock      = 27;   DataBufferLength = 22;
  40.    BGetPrev   =  7;       BReset       = 28;   RejectCount      = 60;
  41.    BGetGr     =  8;       BSetOwner    = 29;   IncorrectDesc    = 62;
  42.    BGetGrEq   =  9;       BClrOwner    = 30;   FilterLimit      = 64;
  43.    BGetLess   = 10;       BCrSuppIdx   = 31;   IncorrectFldOff  = 65;
  44.    BGetLessEq = 11;       BDropSuppIdx = 32;   LostPosition     = 82;
  45.    BGetFirst  = 12;       BStepFirst   = 33;
  46.    BGetLast   = 13;       BStepLast    = 34;
  47.    BCreate    = 14;       BStepPrev    = 35;
  48.    BStat      = 15;       BGetNextExt  = 36;
  49.    BExtend    = 16;       BGetPrevExt  = 37;
  50.    BSetDosDir = 17;       BStepNextExt = 38;
  51.    BGetDosDir = 18;       BStepPrevExt = 39;
  52.    BBegTran   = 19;       BInsertExt   = 40;
  53.    BEndTran   = 20;       BGetKey      = 50;
  54.  
  55. {  Extended Ops Comp Codes/Bias           Extended Ops Logic Constants       }
  56. {  -----------------------------       -----------------------------------   }
  57.    Equal       : byte =   1;           NoFilter    : integer = 0;
  58.    GreaterThan : byte =   2;           LastTerm    : byte    = 0;
  59.    LessThan    : byte =   3;           NextTermAnd : byte    = 1;
  60.    NotEqual    : byte =   4;           NextTermOr  : byte    = 2;
  61.    GrOrEqual   : byte =   5;
  62.    LessOrEqual : byte =   6;
  63.    UseAltColl  : byte =  32;
  64.    UseField    : byte =  64;
  65.    UseNoCase   : byte = 128;
  66.  
  67. {   Other Unit-Specific Constants   }
  68. { --------------------------------- }
  69.    Zero        : integer = 0;
  70.    NotRequired : integer = 0;
  71.    MaxFixedRecLength   =  4090; {Btrieve limits fixed record length for std  }
  72.    MaxKBufferLength    =   255; {files to 4090.  Max key size is 255.        }
  73.    MaxExtDBufferLength = 32767;
  74.  
  75. TYPE
  76.  
  77. (* Data types for TRecMgr object *)
  78. (* ----------------------------- *)
  79.    TVersion    = record
  80.                     case integer of
  81.                     1: (Number  : word;
  82.                         Rev     : integer;
  83.                         Product : char);
  84.                     2: (Entire  : array[1..5] of char);
  85.                     end;
  86.    PRecMgr     = ^TRecMgr;
  87.    TRecMgr     = object(TObject)            {Base obj handles abort/begin/end}
  88.                     Version      : TVersion;{tran, reset, version and stop.  }
  89.                     VersionString: string;
  90.                     constructor Init;
  91.                     function BT(OpCode, Key: integer): integer; virtual;
  92.                     destructor Done; virtual;
  93.                     end;
  94.  
  95. (* Data types for BFile object *)
  96. (* --------------------------- *)
  97.    BFileName   = array[1..80] of char;    {79 + blank pad required by Btrieve}
  98.    TAltColSpec = record               {The data types for alternate collating}
  99.                     case integer of   {sequence are used in CreateFile fcn.  }
  100.                     1: (Header : byte;              {Header always equals $AC}
  101.                         Name   : array[1..8] of char;
  102.                         Table  : array[1..256] of char);
  103.                     2: (Entire : array[1..265] of byte);
  104.                     end;
  105.    PAltColSeq  = ^TAltColSeq;
  106.    TAltColSeq  = object(TObject)
  107.                     Spec : TAltColSpec;
  108.                     constructor Init(SpecName: FNameStr);
  109.                     destructor Done; virtual;
  110.                     end;
  111.    PKeySpec    = ^KeySpec;
  112.    KeySpec     = record                     {data type for a Btrieve key spec}
  113.                     case integer of
  114.                     1: (KeyPos     : integer;
  115.                         KeyLen     : integer;
  116.                         KeyFlags   : integer;             {Tho not used in a }
  117.                         NotUsed    : array[1..4] of byte; {create call, these}
  118.                         ExtKeyType : byte;                {4 bytes return #  }
  119.                         NullValue  : byte;                {unique recs in key}
  120.                         Reserved   : array[1..4] of byte);{after a stat call.}
  121.                     2: (Irrelevant : array[1..3] of integer;
  122.                         NumUnique  : longint);      {great after a stat call!}
  123.                     3: (Entire     : array[1..16] of byte);
  124.                     end;
  125.    PFileSpec   = ^TFileSpec;
  126.    TFileSpec   = record                      {Strictly speaking, the KeyArray}
  127.                     case integer of          {and AltColSpec elements here   }
  128.                     1: (RecLen     : integer;{only serve to reserve space for}
  129.                         PageSize   : integer;{the buffer.                    }
  130.                         NumKeys    : integer;
  131.                         NumRecs    : array[1..2] of integer;
  132.                         FileFlags  : integer;
  133.                         Reserved   : array[1..2] of char;
  134.                         PreAlloc   : integer;
  135.                         KeyArray   : array[0..23] of KeySpec;  {24=max # segs}
  136.                         AltColSpec : TAltColSpec);   {here just to allow room}
  137.                     2: (Irrelevant : array[1..14] of byte;
  138.                         UnusedPgs  : word);         {great after a stat call!}
  139.                     3: (SpecBuf    : integer); {used to refer to addr of spec}
  140.                                         4: (Entire     : array[1..665] of byte);
  141.                     end;
  142.    PBFile      = ^BFile;
  143.    BFile       = object(TObject)
  144.                     DFileName  : FNameStr;                      {DOS filename}
  145.                     Specs      : TFileSpec;               {Btrieve file specs}
  146.                     SpecLength : integer;         {length of actual file spec}
  147.                     NumRecs    : longint;             {# records at Init time}
  148.                     NumSegs    : integer;                   {total # key segs}
  149.                     HasAltCol  : boolean;       {true if file has alt col seq}
  150.                     AltColName : string[8];    {name of alt col seq from file}
  151.                     PosBlk     : array[1..128] of char;       {position block}
  152.                     DBufferLen : integer;
  153.                     constructor Init(UserFileName: FNameStr; OpenMode: integer);
  154.                     function BT(OpCode, Key: integer): integer; virtual;
  155.                     function Open(OpenMode: integer):  integer; virtual;
  156.                     function Close: integer; virtual;
  157.                     destructor Done; virtual;
  158.                     private
  159.                     FileName   : BFileName;            {Btrieve-type filename}
  160.                     procedure ConvertName(UserFileName: FNameStr);
  161.                     end;
  162.  
  163. (* Data types for BFixed object - descendant of BFile *)
  164. (* -------------------------------------------------- *)
  165.    TDBuffer    = array[1..MaxFixedRecLength] of byte;
  166.    TKBuffer    = array[1..MaxKBufferLength] of byte;
  167.    PBFixed     = ^BFixed;
  168.    BFixed      = object(BFile)
  169.                     DBuffer : TDBuffer;
  170.                     KBuffer : TKBuffer;
  171.                     constructor Init(UserFileName: FNameStr; OpenMode: integer);
  172.                                   function BT(OpCode, Key: integer): integer; virtual;
  173.                     destructor Done; virtual;
  174.                     end;
  175.  
  176. (* Data types for BFileExt object - descendant of BFile *)
  177. (* ---------------------------------------------------- *)
  178.    TCharArray  = array[1..255] of char;
  179.    THeader     = record
  180.                     case integer of
  181.                     1: (DBufferLen : integer;
  182.                         Constant   : array[1..2] of char);
  183.                     2: (Entire     : array[1..4] of byte);
  184.                     end;
  185.    TFilter     = record
  186.                     case integer of
  187.                     1: (MaxSkip       : integer;
  188.                         NumLogicTerms : integer);
  189.                     2: (Entire        : array[1..2] of integer);
  190.                     end;
  191.    TLogicTerm  = record
  192.                     case integer of
  193.                     1: (FieldType  : byte;
  194.                         FieldLen   : integer;
  195.                         Offset     : integer;  {0 relative to start of record}
  196.                         CompCode   : byte;
  197.                         Expression : byte;{0 last term, 1 AND next, 2 OR next}
  198.                         case FieldComp: boolean of
  199.                            True : (CompOffset: integer);
  200.                            False: (Value: TCharArray));{an arbitrary limit of}
  201.                     2: (Fixed : array[1..7] of byte);  {255 on len of values }
  202.                     end;
  203.    PFilterSpec = ^TFilterSpec;
  204.    TFilterSpec = object(TObject)
  205.                     LogicTerm: TLogicTerm;
  206.                     constructor InitF(FieldType: byte; FieldLen, Offset:
  207.                                       integer; CompCode, Expression: byte;
  208.                                       CompOffset: integer);
  209.                     constructor InitV(FieldType: byte; FieldLen, Offset:
  210.                                       integer; CompCode, Expression: byte;
  211.                                       Value: TCharArray);
  212.                     destructor Done; virtual;
  213.                     end;
  214.    TExtractor  = record
  215.                     case integer of
  216.                     1: (NumRecords : integer;
  217.                         NumFields  : integer);
  218.                     2: (Entire     : array[1..2] of integer);
  219.                     end;
  220.    TExtRepeater= record
  221.                     FieldLen : integer;
  222.                     Offset   : integer;
  223.                     end;
  224.    PExtSpec    = ^TExtSpec;
  225.    TExtSpec    = object(TObject)
  226.                     ExtRepeater : TExtRepeater;
  227.                     constructor Init(Len, Ofs: integer);
  228.                     destructor Done; virtual;
  229.                     end;
  230.    PExtDBuffer = ^TExtDBuffer;
  231.    TExtDBuffer = record
  232.                     case integer of
  233.                     1: (Header   : THeader;       {Buffer sent includes these}
  234.                         Filter   : TFilter);         {types at its beginning.}
  235.                     2: (NumRecs  : integer;               {Buffer rec'd looks}
  236.                         Repeater : array[1..32765] of char);      {like this.}
  237.                     {Repeater structure is: 2 for length of record image,    }
  238.                     {                       4 for currency position of rec,  }
  239.                     {                       n for record image itself        }
  240.                     3: (Entire   : array[1..32767] of byte);   {Whole buffer.}
  241.                     end;
  242.    PBFileExt   = ^BFileExt;
  243.    BFileExt    = object(BFile)
  244.                     Header        : THeader;
  245.                     Filter        : TFilter;
  246.                     FilterSpec    : PCollection;
  247.                     Extractor     : TExtractor;
  248.                     ExtractorSpec : PCollection;
  249.                     ExtDBuffer    : PExtDBuffer;
  250.                     constructor Init(UserFileName: FNameStr; OpenMode: integer);
  251.                     function BTExt(OpCode, Key: integer): integer; virtual;
  252.                     destructor Done; virtual;
  253.                     private
  254.                     procedure SetExtDBufferLen;
  255.                     procedure MakeExtDBuffer;
  256.                     end;
  257.  
  258.  
  259. (* PUBLIC/EXPORTED VARS *)
  260. (* -------------------- *)
  261. VAR
  262.      BStatus        : integer;
  263.      VarNotRequired : integer;                              {Dummy parameter.}
  264.      VarPosBlk      : array[1..128] of char;    {Dummy used in ops that don't}
  265.                                                 {pass/return position block. }
  266.  
  267. (* PUBLIC/EXPORTED FUNCTIONS *)
  268. (* ------------------------- *)
  269. {The Btrv function declared here is public, but should not ever be needed. It
  270.  is included in the public declaration only to be complete and give you
  271.  access to the standard call if you should need it.}
  272.  
  273. function Btrv(Op:integer; var Pos,Data; var DataLen:integer; var KBuf;
  274.               Key:integer): integer;
  275. function CreateFile(UserFileName: FNameStr; UserFileSpec:PFileSpec;
  276.                     AltColFile: FNameStr): integer;
  277. function CloneFile(CurrentFile, NewFile: FNameStr): integer;
  278. function LTrim(S: String): String;   {LTrim and RTrim were taken from one of }
  279. function RTrim(S: String): String;   {the Turbo Vision .PAS source files.    }
  280.  
  281.  
  282. IMPLEMENTATION
  283. (* ------------------------------------------------------------------------ *)
  284. (* ------------------------------------------------------------------------ *)
  285. USES Dos;        {Dos unit needed for the Btrieve interface call (interrupts)}
  286.  
  287. {$R-}     {Range checking off...is TP's default}
  288. {$B+}     {Boolean complete evaluation on...NOT a default, but apparently
  289.           required by the interface call.  Is turned off at end of Btrieve
  290.           interface definition}
  291. {$V-}    {Non-strict string var checking...Btrieve wants it so.  Strict
  292.           checking is turned back on at the end of the interface definition.}
  293. {$S+}     {Stack checking on}
  294. {$I+}     {I/O checking on}
  295.  
  296. {  Module Name: TUR5BTRV.PAS                                                 }
  297.  
  298. {  Description: This is the Btrieve interface for Turbo Pascal (MS-DOS).     }
  299. {        This routine sets up the parameter block expected by         }
  300. {        Btrieve, and issues interrupt 7B.  It should be compiled     }
  301. {        with the $V- switch so that runtime checks will not be         }
  302. {        performed on the variable parameters.                 }
  303. {                                         }
  304. {  Synopsis:    STAT := BTRV (OP, POS.START, DATA.START, DATALEN,         }
  305. {                 KBUF.START, KEY);                 }
  306. {                  where                         }
  307. {            OP is an integer,                     }
  308. {            POS is a 128 byte array,                 }
  309. {            DATA is an untyped parameter for the data buffer,    }
  310. {            DATALEN is the integer length of the data buffer,    }
  311. {            KBUF is the untyped parameter for the key buffer,    }
  312. {            and KEY is an integer.                     }
  313. {                                         }
  314. {  Returns:    Btrieve status code (see Appendix B of the Btrieve Manual).  }
  315. {                                         }
  316. {  Note:    The Btrieve manual states that the 2nd, 3rd, and 5th         }
  317. {        parameters be declared as variant records, with an integer   }
  318. {        type as one of the variants (used only for Btrieve calls),   }
  319. {        as is shown in the example below.  This is supported, but    }
  320. {        the restriction is no longer necessary.  In other words, any }
  321. {        variable can be sent in those spots as long as the variable  }
  322. {        uses the correct amount of memory so Btrieve does not         }
  323. {        overwrite other variables.                     }
  324. {                                         }
  325. {           var DATA = record case boolean of                 }
  326. {              FALSE: ( START: integer );                 }
  327. {              TRUE:  ( EMPLOYEE_ID: 0..99999;                 }
  328. {                   EMPLOYEE_NAME: packed array[1..50] of char;   }
  329. {                   SALARY: real;                     }
  330. {                   DATA_OF_HIRE: DATE_TYPE );             }
  331. {              end;                             }
  332. {                                         }
  333. {        There should NEVER be any string variables declared in the   }
  334. {        data or key records, because strings store an extra byte for }
  335. {        the length, which affects the total size of the record.      }
  336. {                                         }
  337. {                                         }
  338.  
  339. (* BTRV function *)
  340. (* ------------- *)
  341. function Btrv (Op: integer; var Pos, Data; var DataLen: integer; var Kbuf;
  342.                Key: integer): integer;
  343.  
  344. const
  345.      VAR_ID        = $6176;       {id for variable length records - 'va'}
  346.      BTR_INT        = $7B;
  347.      BTR2_INT        = $2F;
  348.      BTR_OFFSET     = $0033;
  349.      MULTI_FUNCTION    = $AB;
  350.  
  351. {  ProcId is used for communicating with the Multi Tasking Version of         }
  352. {  Btrieve. It contains the process id returned from BMulti and should         }
  353. {  not be changed once it has been set.                      }
  354. {                                         }
  355.      ProcId: integer = 0;                   { initialize to no process id }
  356.      MULTI: boolean = false;               { set to true if BMulti is loaded }
  357.      VSet: boolean = false;     { set to true if we have checked for BMulti }
  358.  
  359. type
  360.      ADDR32 = record                          {32 bit address}
  361.         OFFSET : word;                             {&&&old->integer}
  362.         SEGMENT: word;                            {&&&used->integer}
  363.      end;
  364.  
  365.      BTR_PARMS = record
  366.     USER_BUF_ADDR: ADDR32;                         {data buffer address}
  367.     USER_BUF_LEN: integer;                  {data buffer length}
  368.     USER_CUR_ADDR: ADDR32;                  {currency block address}
  369.     USER_FCB_ADDR: ADDR32;              {file control block address}
  370.     USER_FUNCTION: integer;                    {Btrieve operation}
  371.     USER_KEY_ADDR: ADDR32;                  {key buffer address}
  372.     USER_KEY_LENGTH: BYTE;                   {key buffer length}
  373.     USER_KEY_NUMBER: shortint;              {key number&&&old->BYTE}
  374.     USER_STAT_ADDR: ADDR32;                    {return status address}
  375.     XFACE_ID: integer;                       {language interface id}
  376.      end;
  377.  
  378. var
  379.      STAT: integer;                     {Btrieve status code}
  380.      XDATA: BTR_PARMS;                     {Btrieve parameter block}
  381.      REGS: Dos.Registers;      {register structure used on interrrupt call}
  382.      DONE: boolean;
  383.  
  384. begin
  385.      REGS.AX := $3500 + BTR_INT;
  386.      INTR ($21, REGS);
  387.      if (REGS.BX <> BTR_OFFSET) then          {make sure Btrieve is installed}
  388.     STAT := 20
  389.      else
  390.     begin
  391.        if (not VSet) then    {if we haven't checked for Multi-User version}
  392.           begin
  393.          REGS.AX := $3000;
  394.          INTR ($21, REGS);
  395.          if ((REGS.AX AND $00FF) >= 3) then
  396.             begin
  397.                VSet := true;
  398.                REGS.AX := MULTI_FUNCTION * 256;
  399.                INTR (BTR2_INT, REGS);
  400.                MULTI := ((REGS.AX AND $00FF) = $004D);
  401.             end
  402.          else
  403.             MULTI := false;
  404.           end;
  405.                             {make normal btrieve call}
  406.        with XDATA do
  407.           begin
  408.          USER_BUF_ADDR.SEGMENT := SEG (DATA);
  409.          USER_BUF_ADDR.OFFSET := OFS (DATA); {set data buffer address}
  410.          USER_BUF_LEN := DATALEN;
  411.          USER_FCB_ADDR.SEGMENT := SEG (POS);
  412.          USER_FCB_ADDR.OFFSET := OFS (POS);         {set FCB address}
  413.          USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
  414.          USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
  415.          USER_FUNCTION := OP;          {set Btrieve operation code}
  416.          USER_KEY_ADDR.SEGMENT := SEG (KBUF);
  417.          USER_KEY_ADDR.OFFSET := OFS (KBUF);  {set key buffer address}
  418.          USER_KEY_LENGTH := 255;         {assume its large enough}
  419.          USER_KEY_NUMBER := KEY;              {set key number}
  420.          USER_STAT_ADDR.SEGMENT := SEG (STAT);
  421.          USER_STAT_ADDR.OFFSET := OFS (STAT);      {set status address}
  422.          XFACE_ID := VAR_ID;                 {set lamguage id}
  423.           end;
  424.  
  425.        REGS.DX := OFS (XDATA);
  426.        REGS.DS := SEG (XDATA);
  427.  
  428.        if (NOT MULTI) then             {MultiUser version not installed}
  429.           INTR (BTR_INT, REGS)
  430.        else
  431.           begin
  432.          DONE := FALSE;
  433.          repeat
  434.             REGS.BX := ProcId;
  435.             REGS.AX := 1;
  436.             if (REGS.BX <> 0) then
  437.                REGS.AX := 2;
  438.             REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
  439.             INTR (BTR2_INT, REGS);
  440.             if ((REGS.AX AND $00FF) = 0) then
  441.                DONE := TRUE
  442.             else begin
  443.                REGS.AX := $0200;
  444.                INTR ($7F, REGS);
  445.                DONE := FALSE;
  446.             end;
  447.          until (DONE);
  448.          if (ProcId = 0) then
  449.             ProcId := REGS.BX;
  450.           end;
  451.        DATALEN := XDATA.USER_BUF_LEN;
  452.     end;
  453.      BTRV := STAT;
  454. end;
  455. {$B-}
  456. {$V+}
  457.  
  458.  
  459. (* BRECMGR.INIT Constructor *)
  460. (* ------------------------ *)
  461. constructor TRecMgr.Init;
  462. var
  463.    Counter  : integer;
  464.    BNumber,
  465.    BRev     : string[2];
  466.    BProduct : string[1];
  467. begin
  468.    TObject.Init;                              {assures all data fields zeroed}
  469.    BStatus := Btrv(BVersion, VarPosBlk, Version, Counter, VarNotRequired, Zero);
  470.    str(Version.Number:2, BNumber);
  471.    BNumber := LTrim(BNumber);
  472.    str(Version.Rev:2, BRev);
  473.    BProduct := Version.Product;
  474.    VersionString := BNumber + '.' + BRev + BProduct;
  475. end;
  476.  
  477. (* BRECMGR.BT function *)
  478. (* ------------------- *)
  479. {Will not handle reset of other workstations as written, as no true key
  480.  buffer is passed.   Will handle begin/end/abort transaction, reset & stop.
  481.  Would also handle version op, but is handled by BRecMgr.Init anyway!}
  482. function TRecMgr.BT(OpCode, Key: integer): integer;
  483. begin
  484.    BT := Btrv(OpCode, VarPosBlk, VarNotRequired, VarNotRequired,
  485.               VarNotRequired, Key);
  486. end;
  487.  
  488. (* BRECMGR Destructor *)
  489. (* ------------------ *)
  490. destructor TRecMgr.Done;
  491. begin
  492.    TObject.Done;
  493. end;
  494.  
  495.  
  496. (* TALTCOLSEQ.INIT Constructor *)
  497. (* ---------------------------- *)
  498. constructor TAltColSeq.Init(SpecName: FNameStr);
  499. var
  500.    AltFile: file of TAltColSpec;      {The TAltColSpec object type is used   }
  501. begin                                 {internally by the CreateFile function.}
  502.    TObject.Init;
  503.    assign(AltFile, SpecName);
  504.    {$I-} reset(AltFile); {$I+}    {It's up to user program to assure that the}
  505.    if ioresult = 0 then           {alternate collating sequence file exists  }
  506.      begin                        {in the current directory when the         }
  507.        read(AltFile, Spec);       {CreateFile fcn is called, and is of the   }
  508.        close(AltFile);            {standard format expected by Btrieve.      }
  509.      end
  510.      else
  511.      Fail;
  512. end;
  513.  
  514.  
  515. (* TALTCOLSEQ.DONE Destructor *)
  516. (* --------------------------- *)
  517. destructor TAltColSeq.Done;
  518. begin
  519.    TObject.Done;
  520. end;
  521.  
  522.  
  523. (* BFILE.INIT Constructor *)
  524. (* ---------------------- *)
  525. constructor BFile.Init(UserFileName: FNameStr; OpenMode: integer);
  526.  
  527. const                          {665 = 16 for filespec + 384 for max key specs}
  528.    FileBufLen : integer = 665; {+ 265 for an alternate collating sequence.   }
  529.    KeyBufLen  : integer = 384;       {Max of 24 keys * 16 bytes per key spec.}
  530.  
  531. var
  532.    AltColNameOffset,
  533.    Counter, Counter1,
  534.    Status             : integer;
  535.    NumRecsWord1,
  536.    NumRecsWord2       : word;
  537.  
  538. procedure CountSegments;
  539. begin
  540.    repeat
  541.    if (Specs.KeyArray[Counter1].KeyFlags and Segmented) = Segmented then
  542.       begin
  543.       if (Specs.KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
  544.          HasAltCol  := true;
  545.       inc(NumSegs);
  546.       inc(Counter1);
  547.       end
  548.       else
  549.       begin
  550.       if (Specs.KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
  551.          HasAltCol  := true;
  552.       inc(Counter);
  553.       inc(Counter1);
  554.       end;
  555.    until (Specs.KeyArray[Counter1].KeyFlags and Segmented) <> Segmented;
  556. end;
  557.  
  558. begin
  559.    TObject.Init;                              {assures all data fields zeroed}
  560.    HasAltCol := false;            {initialize to false 'until proven guilty!'}
  561.    ConvertName(UserFileName);             {Sets fields DFileName and FileName}
  562.    Status := Open(OpenMode);
  563.    if Status = 0 then                    {if open op successful, do a stat op}
  564.       begin
  565.          Status := Btrv(BStat, PosBlk, Specs.SpecBuf, FileBufLen, KeyBufLen,
  566.                         Zero);
  567.          {Btrieve filespecs and key specs are now in the BFile object!}
  568.          {Typed constant FileBufLen will have been changed to size of data
  569.           buffer returned by stat call.  Save that value now.}
  570.          SpecLength := FileBufLen;
  571.          if Status = 0 then     {if stat successfull, fill object data fields}
  572.             begin
  573.                NumRecsWord1 := Specs.NumRecs[1];  {get rid of sign bit!! by  }
  574.                NumRecsWord2 := Specs.NumRecs[2];  {converting 2 ints to words}
  575.                NumRecs := NumRecsWord1 + NumRecsWord2 * 65536;
  576.                NumSegs := Specs.NumKeys;
  577.                Counter := 1; Counter1 := 0;
  578.                while Counter <= Specs.NumKeys do     {Will be skipped if data}
  579.                   CountSegments;                     {only file.             }
  580.                if HasAltCol = true then
  581.                   begin
  582.                   AltColNameOffset := (16+16*NumSegs+1);
  583.                   for Counter := 1 to 8 do
  584.                      AltColName[Counter] := chr(Specs.Entire[AltColNameOffset + Counter]);
  585.                   end;
  586.                DBufferLen := Specs.RecLen;
  587.                BStatus := 0;                  {all went well, return a code 0}
  588.             end
  589.             else
  590.             begin
  591.                BStatus := Status;  {Open op succeeded but stat failed; put   }
  592.                Status  := Close;   {error code for bad stat in global var and}
  593.             end;                   {close the damn file quick!}
  594.          end
  595.    else
  596.    BStatus := Status;             {assign err code for bad open to global var}
  597. end;
  598.  
  599. (* BFILE.BT function *)
  600. (* ----------------- *)
  601. function BFile.BT(OpCode, Key: integer): integer;
  602. begin
  603.    Abstract;
  604. end;
  605.  
  606. (* BFILE.OPEN function *)
  607. (* ------------------- *)
  608. function BFile.Open(OpenMode: integer):integer;
  609. begin
  610.    Open := Btrv(BOpen, PosBlk, VarNotRequired, Specs.RecLen, FileName, OpenMode);
  611. end;
  612.  
  613. (* BFILE.CLOSE Function *)
  614. (* -------------------- *)
  615. function BFile.Close:integer;
  616. begin
  617.    Close := Btrv(BClose, PosBlk, VarNotRequired, VarNotRequired,
  618.                  VarNotRequired, NotRequired);
  619. end;
  620.  
  621. (* BFILE.DONE Destructor *)
  622. (* --------------------- *)
  623. destructor BFile.Done;
  624. begin
  625.    TObject.Done;
  626. end;
  627.  
  628. (* BFILE.CONVERTNAME Procedure *)
  629. (* --------------------------- *)
  630. {this one is private to BFile}
  631. procedure BFile.ConvertName(UserFileName: FNameStr);
  632. begin
  633.    DFileName := UserFileName;
  634.    move(DFileName[1], FileName[1], length(DFileName));  {conv string to array}
  635.    FileName[length(DFileName) + 1] := ' ';         {provide required pad char}
  636. end;
  637.  
  638. (* BFIXED.INIT Constructor *)
  639. (* ----------------------- *)
  640. constructor BFixed.Init(UserFileName: FNameStr; OpenMode: integer);
  641. begin
  642.    BFile.Init(UserFileName, OpenMode);
  643. end;
  644.  
  645. (* BFIXED.BT function *)
  646. (* ----------------- *)
  647. function BFixed.BT(OpCode, Key: integer): integer;
  648. begin
  649.    BT := Btrv(OpCode, PosBlk, DBuffer, Specs.RecLen, KBuffer, Key);
  650. end;
  651.  
  652. (* BFIXED.DONE Destructor *)
  653. (* ---------------------- *)
  654. destructor BFixed.Done;
  655. begin
  656.    BFile.Done;
  657. end;
  658.  
  659. (* TFILTERSPEC.INITF Constructor *)
  660. (* ----------------------------- *)
  661. {Be sure to remember that the offset parameter here is 0 relative to start of
  662.  record!!}
  663. constructor TFilterSpec.InitF(FieldType: byte; FieldLen, Offset: integer;
  664.                               CompCode, Expression: byte; CompOffset: integer);
  665. begin
  666.    TObject.Init;                              {assures all data fields zeroed}
  667.    LogicTerm.FieldType  := FieldType;
  668.    LogicTerm.FieldLen   := FieldLen;
  669.    LogicTerm.Offset     := Offset;
  670.    LogicTerm.CompCode   := CompCode;
  671.    LogicTerm.Expression := Expression;
  672.    LogicTerm.FieldComp  := true;
  673.    LogicTerm.CompOffset := Offset;
  674. end;
  675.  
  676. (* TFILTERSPEC.INITV Constructor *)
  677. (* ----------------------------- *)
  678. {Be sure to remember that the offset parameter here is 0 relative to start of
  679.  record!!}
  680. constructor TFilterSpec.InitV(FieldType: byte; FieldLen, Offset: integer;
  681.                               CompCode, Expression: byte; Value: TCharArray);
  682. begin
  683.    TObject.Init;                              {assures all data fields zeroed}
  684.    LogicTerm.FieldType := FieldType;
  685.    LogicTerm.FieldLen  := FieldLen;
  686.    LogicTerm.Offset    := Offset;
  687.    LogicTerm.CompCode  := CompCode;
  688.    LogicTerm.Expression:= Expression;
  689.    LogicTerm.FieldComp := false;
  690.    LogicTerm.Value     := Value;
  691. end;
  692.  
  693. (* TFILTERSPEC.DONE Destructor *)
  694. (* --------------------------- *)
  695. destructor TFilterSpec.Done;
  696. begin
  697.    TObject.Done;
  698. end;
  699.  
  700. (* TEXTSPEC.INIT Constructor *)
  701. (* ------------------------- *)
  702. constructor TExtSpec.Init(Len, Ofs: integer);
  703. begin
  704.    TObject.Init;                              {assures all data fields zeroed}
  705.    ExtRepeater.FieldLen := Len;
  706.    ExtRepeater.Offset   := Ofs;
  707. end;
  708.  
  709. (* TEXTSPEC.DONE Destructor *)
  710. (* ----------------------- *)
  711. destructor TExtSpec.Done;
  712. begin
  713.    TObject.Done;
  714. end;
  715.  
  716. (* BFILEEXT.INIT Constructor *)
  717. (* ------------------------- *)
  718. {always check for a failure!}
  719. constructor BFileExt.Init(UserFileName: FNameStr; OpenMode: integer);
  720. begin
  721.    BFile.Init(UserFileName, OpenMode);
  722.    Header.Constant[1] := 'E';
  723.    Header.Constant[2] := 'G';
  724.    ExtDBuffer    := memallocseg(MaxExtDBufferLength);
  725.    FilterSpec    := new(PCollection, Init(2,2));
  726.    ExtractorSpec := new(PCollection, Init(5,2));
  727.    if (ExtDBuffer = nil) or (FilterSpec = nil) or (ExtractorSpec = nil) then
  728.       Fail;
  729. end;
  730.  
  731. (* BFILEEXT.DONE Destructor *)
  732. (* ------------------------ *)
  733. destructor BFileExt.Done;
  734. begin
  735.    BFile.Done;
  736.    dispose(ExtDBuffer);
  737.    dispose(ExtractorSpec, Done);
  738.    dispose(FilterSpec, Done);
  739. end;
  740.  
  741. (* BFILEEXT.SETEXTDBUFFERLEN function *)
  742. (* ---------------------------------- *)
  743. {Compute sizes of data buffers sent and returned, to determine proper size to
  744.  specify in call.}
  745. {Assumes user program has inserted proper items into the collections for
  746.  filter terms and extractor specs.}
  747. procedure BFileExt.SetExtDBufferLen;
  748. var
  749.    LengthSent, LengthReturned,
  750.    RecordLengthReturned, RecordImageReturned : integer;
  751.  
  752.    procedure MakeFilterSpecs;
  753.       procedure CalcFilterLengths(FSpec: PFilterSpec); far;
  754.       begin
  755.       with FSpec^ do
  756.          begin
  757.          inc(LengthSent, 7);
  758.          if (LogicTerm.CompCode and UseField) = UseField then
  759.             inc(LengthSent, 2)
  760.             else
  761.             LengthSent := LengthSent + LogicTerm.FieldLen;
  762.          end;
  763.       end;
  764.    begin
  765.       FilterSpec^.ForEach(@CalcFilterLengths);
  766.    end;
  767.  
  768.    procedure MakeExtSpecs;
  769.       procedure CalcExtLengths(ExtSpec: PExtSpec); far;
  770.       begin
  771.          with ExtSpec^ do
  772.             begin
  773.             inc(LengthSent, 4);
  774.             RecordLengthReturned := RecordLengthReturned + ExtRepeater.FieldLen;
  775.             end;
  776.       end;
  777.    begin
  778.       ExtractorSpec^.ForEach(@CalcExtLengths);
  779.    end;
  780.  
  781. begin
  782.    LengthSent := 8; {4 for header length, 4 for fixed filter length}
  783.  
  784.    {Work on filter logic term portion of spec.}
  785.    if FilterSpec^.Count > 0 then       {if any filter terms in the collection}
  786.       MakeFilterSpecs;
  787.  
  788.    {Work on extractor portion of spec.}
  789.    inc(LengthSent, 4);                       {size of fixed part of extractor}
  790.    RecordLengthReturned := 0;
  791.    MakeExtSpecs;              {there must always be at least 1 extractor spec}
  792.  
  793.    {2 for count of recs, 4 for currency pos}
  794.    RecordImageReturned := RecordLengthReturned + 6; 
  795.    {2 for count of recs}
  796.    LengthReturned := 2 + (RecordImageReturned * Extractor.NumRecords);
  797.  
  798.    Header.DBufferLen := LengthSent;
  799.  
  800.    if LengthSent >= LengthReturned then
  801.       DBufferLen := LengthSent
  802.       else
  803.       DBufferLen := LengthReturned;
  804. end;
  805.  
  806. (* BFILEEXT.MAKEEXTDBUFFER Function *)
  807. (* -------------------------------- *)
  808. {Private to BFileExt, called in BFileExt.BT, which is called by each
  809.  descendant's override of BFileExt.BT.  Assumes program has already set up
  810.  the collections required.}
  811. procedure BFileExt.MakeExtDBuffer;
  812. var
  813.    Offset : integer;
  814.  
  815.    procedure MoveFilterSpecs;
  816.       procedure MoveSingleFilterSpec(FSpec: PFilterSpec); far;
  817.       begin
  818.          with FSpec^ do
  819.             begin
  820.             {move fixed part of logic term}
  821.             move(LogicTerm, ExtDBuffer^.Entire[Offset], sizeof(LogicTerm.Fixed));
  822.             inc(Offset, sizeof(LogicTerm.Fixed));
  823.             {now need to move variable part of logic term}
  824.             if (LogicTerm.CompCode and UseField) = UseField then
  825.                begin
  826.                move(LogicTerm.CompOffset, ExtDBuffer^.Entire[Offset],
  827.                     sizeof(LogicTerm.CompOffset));
  828.                Offset := Offset + sizeof(LogicTerm.CompOffset);
  829.                end
  830.                else
  831.                begin
  832.                move(LogicTerm.Value, ExtDBuffer^.Entire[Offset],
  833.                     LogicTerm.FieldLen);
  834.                Offset := Offset + LogicTerm.FieldLen;
  835.                end;
  836.             end;
  837.       end;
  838.    begin
  839.       FilterSpec^.ForEach(@MoveSingleFilterSpec);
  840.    end;
  841.  
  842.    procedure MoveExtractorSpecs;
  843.       procedure MoveSingleExtractorSpec(ExtSpec: PExtSpec); far;
  844.       begin
  845.         with ExtSpec^ do
  846.            begin
  847.            move(ExtSpec^.ExtRepeater, ExtDBuffer^.Entire[Offset],
  848.                 sizeof(ExtSpec^.ExtRepeater));
  849.            Offset := Offset + sizeof(ExtSpec^);
  850.            end;
  851.       end;
  852.    begin
  853.       ExtractorSpec^.ForEach(@MoveSingleExtractorSpec);
  854.    end;
  855.  
  856. begin
  857.    {Move header definition into buffer.}
  858.    move(Header, ExtDBuffer^.Header, sizeof(Header));
  859.  
  860.    {Move fixed part of filter definition into buffer.}
  861.    move(Filter, ExtDBuffer^.Filter, sizeof(Filter));
  862.    Offset := 1 + sizeof(Header) + sizeof(Filter);
  863.  
  864.    {Read filter logic terms into buffer.}
  865.    if FilterSpec^.Count > 0 then
  866.       MoveFilterSpecs;
  867.  
  868.    {Move fixed part of extractor definition into buffer.}
  869.    move(Extractor, ExtDBuffer^.Entire[Offset], sizeof(Extractor.Entire));
  870.    Offset := Offset + sizeof(Extractor.Entire);
  871.  
  872.    {Move extractor terms into buffer.}
  873.    MoveExtractorSpecs;
  874. end;
  875.  
  876. (* BFILEEXT.BTEXT function *)
  877. (* ----------------------- *)
  878. {In overrides of this function in BFileExt descendants, MUST call
  879.  BFileExt.BTExt, as it sets the buffer length in the header, and puts
  880.  together the 'send' buffer.  User program MUST have inserted filter logic
  881.  terms and extractor specs into their respective collections before making
  882.  a Btrieve call.}
  883. function BFileExt.BTExt(OpCode, Key: integer): integer;
  884. begin
  885.    SetExtDBufferLen;
  886.    MakeExtDBuffer;
  887. end;
  888.  
  889.  
  890. (* CREATEFILE function *)
  891. (* -------------------- *)
  892. {Assumes a PFILESPEC variable has been instantiated and assigned its values,
  893.  and that if you use an alternate collating sequence, it exists in the
  894.  current directory.}
  895. {No specific support for null keys, blank compression, data-only files.}
  896. function CreateFile(UserFileName: FNameStr; UserFileSpec:PFileSpec;
  897.                     AltColFile: FNameStr): integer;
  898. var
  899.    CFSpecLength,
  900.    Counter,
  901.    Counter1,
  902.    NumSegs         : integer;
  903.    BtrieveFileName : BFileName;
  904.    HasAltCol       : boolean;
  905.    AltColObj       : PAltColSeq;
  906.  
  907. procedure CountSegments;
  908. begin
  909.    with UserFileSpec^ do
  910.    repeat
  911.    if (KeyArray[Counter1].KeyFlags and Segmented) = Segmented then
  912.       begin
  913.       if (KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
  914.          HasAltCol  := true;
  915.       inc(NumSegs);
  916.       inc(Counter1);
  917.       end
  918.       else
  919.       begin
  920.       if (KeyArray[Counter1].KeyFlags and AltCol) = AltCol then
  921.          HasAltCol  := true;
  922.       inc(Counter);
  923.       inc(Counter1);
  924.       end;
  925.    until (KeyArray[Counter1].KeyFlags and Segmented) <> Segmented;
  926. end;
  927.  
  928. begin
  929.    move(UserFileName[1], BtrieveFileName[1], length(UserFileName));
  930.    BtrieveFileName[length(UserFileName) + 1] := ' ';
  931.    Counter := 1; Counter1 := Counter;
  932.    NumSegs := UserFileSpec^.NumKeys;
  933.    while Counter <= UserFileSpec^.NumKeys do
  934.       CountSegments;
  935.    CFSpecLength := 16 + (NumSegs * 16);
  936.    UserFileSpec^.Reserved[1] := chr(0);
  937.    UserFileSpec^.Reserved[2] := chr(0);
  938.    if (AltColFile <> '') and (HasAltCol = true) then  {Note the double check!}
  939.       begin
  940.       AltColObj   := new(PAltColSeq, Init(AltColFile));
  941.       move(AltColObj^.Spec, UserFileSpec^.Entire[CFSpecLength+1],
  942.          sizeof(AltColObj^.Spec));
  943.       CFSpecLength := CFSpecLength + sizeof(AltColObj^.Spec);
  944.       dispose(AltColObj, Done);
  945.       end;
  946.    CreateFile := Btrv(BCreate, VarPosBlk, UserFileSpec^.SpecBuf, CFSpecLength,
  947.                       BtrieveFileName, Zero);
  948. end;
  949.  
  950. (* CLONEFILE function *)
  951. (* ------------------ *)
  952. {Programmer is responsible for assuring that 'CurrentFile' exists and can be
  953.  opened.  Function will overwrite any existing file with 'NewFile' name.
  954.  The integer returned here can be meaningless if the current file does not
  955.  exist or is not opened properly.  This function is as streamlined as
  956.  possible, but puts RESPONSIBILITY on the programmer.
  957.  
  958.  It is entirely possible that this clone function will NOT return a byte for
  959.  byte matching file, if cloning an 'empty' Btrieve file.  This would be due
  960.  to the inability to determine the number of pages pre-allocated when a file
  961.  was created, if preallocation had been used.  The Btrieve Stat call uses
  962.  the 'Preallocate # of pages' bytes to return the number of unused pages!!
  963.  Thus, the CloneFile function clears the Preallocation bit in the FileFlags,
  964.  among other things, before creating the new file.}
  965.  
  966. function CloneFile(CurrentFile, NewFile:FNameStr): integer;
  967. var
  968.    Counter, Counter1 : integer;
  969.    CurrentBFile      : PBFile;
  970.    NewBFile          : BFileName;
  971. begin
  972.    CurrentBFile := new(PBFile, Init(CurrentFile, ReadOnly));
  973.  
  974.    move(NewFile[1], NewBFile[1], length(NewFile));
  975.    NewBFile[length(NewFile) + 1] := ' ';
  976.  
  977.    {Undo the 'damage' due to a virgin filespec by the stat call on init of
  978.     the CurrentBFile object...tho technically the 'NotUsed' bytes we clear
  979.     in the next 'if' probably do NOT really need to be cleared.}
  980.    if CurrentBFile^.NumSegs > 0 then              {don't do if data only file}
  981.       {Zero the bytes that after the init call hold # unique records!}
  982.       for Counter := 1 to CurrentBFile^.NumSegs do
  983.          fillchar(CurrentBFile^.Specs.KeyArray[Counter].NotUsed, 4, 0);
  984.  
  985.    {Clear the PreAllocate file flag bit if it had been set in CurrentBFile.}
  986.    CurrentBFile^.Specs.FileFlags := CurrentBFile^.Specs.FileFlags and $FD;
  987.    CurrentBFile^.Specs.UnusedPgs := 0; {If preallocate file flag was set, the}
  988.                                         {cloned file will have no pages pre- }
  989.                                         {allocated...NO way to get the       }
  990.                                         {original # of pre-allocated pages!  }
  991.  
  992.    CloneFile := Btrv(BCreate, VarPosBlk, CurrentBFile^.Specs,
  993.                      CurrentBFile^.SpecLength, NewBFile, Zero);
  994.    BStatus := CurrentBFile^.Close;
  995.    dispose(CurrentBFile, Done);
  996. end;
  997.  
  998. {LTrim and RTrim were taken from one of the Turbo Vision .PAS source files!}
  999. function LTrim(S: String): String;
  1000. var
  1001.    I: integer;
  1002. begin
  1003.    I := 1;
  1004.    while (I < length(S)) and (S[I] = ' ') do inc(I);
  1005.    LTrim := copy(S, I, 255);
  1006. end;
  1007.  
  1008. function RTrim(S: String): String;
  1009. var
  1010.    I: integer;
  1011. begin
  1012.    while S[Length(S)] = ' ' do dec(S[0]);
  1013.    RTrim := S;
  1014. end;
  1015.  
  1016.  
  1017. (* IS BTRIEVE LOADED procedure *)
  1018. (* --------------------------- *)
  1019. {this is private to the unit, and is executed only during unit initialization}
  1020. procedure IsBtrieveLoaded;
  1021. begin
  1022.    BStatus := Btrv(BReset, VarPosBlk, VarNotRequired, VarNotRequired,
  1023.                    VarNotRequired, Zero);
  1024.    if BStatus = 20 then
  1025.       begin
  1026.       writeln('Please load Btrieve before running this program.');
  1027.       halt;
  1028.       end;
  1029. end;
  1030.  
  1031.  
  1032. (* INITIALIZATION Section *)
  1033. (* ----------------------------------------------------------------------- *)
  1034. BEGIN
  1035.  
  1036.    IsBtrieveLoaded;
  1037.  
  1038. END.
  1039.  
  1040.